home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / images1a / module1.bas < prev    next >
BASIC Source File  |  1999-09-21  |  4KB  |  87 lines
  1. Attribute VB_Name = "Module1"
  2. '*******************************************************
  3. '
  4. 'This module is all you need to start making your
  5. 'own Image Shaped Forms!
  6. '
  7. '*******************************************************
  8.  
  9. 'General Api Declarations
  10. Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  11. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  12. Public Declare Function ReleaseCapture Lib "user32" () As Long
  13. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  14. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  15. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  16. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  17. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  18. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  19. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  20. Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
  21.  
  22. Private Type BITMAP
  23.     bmType As Long
  24.     bmWidth As Long
  25.     bmHeight As Long
  26.     bmWidthBytes As Long
  27.     bmPlanes As Integer
  28.     bmBitsPixel As Integer
  29.     bmBits As Long
  30. End Type
  31.  
  32. Public Const WM_NCLBUTTONDOWN = &HA1
  33. Public Const HTCAPTION = 2
  34.  
  35. 'This the Main Code to make an Image Shaped Form
  36. 'What it does is scan the Image passed to it and then
  37. 'remove all lines that correspond to the Transparent
  38. 'Color, creating a new virtual image, but without a
  39. 'particular color
  40.  
  41. Public Function GetBitmapRegion(cPicture As StdPicture, cTransparent As Long)
  42. 'Variable Declaration
  43.     Dim hRgn As Long, tRgn As Long
  44.     Dim X As Integer, Y As Integer, X0 As Integer
  45.     Dim hDC As Long, BM As BITMAP
  46. 'Create a new memory DC, where we will scan the picture
  47.     hDC = CreateCompatibleDC(0)
  48.     If hDC Then
  49. 'Let the new DC select the Picture
  50.         SelectObject hDC, cPicture
  51. 'Get the Picture dimensions and create a new rectangular
  52. 'region
  53.         GetObject cPicture, Len(BM), BM
  54.         hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM.bmHeight)
  55. 'Start scanning the picture from top to bottom
  56.         For Y = 0 To BM.bmHeight
  57.             For X = 0 To BM.bmWidth
  58. 'Scan a line of non transparent pixels
  59.                 While X <= BM.bmWidth And GetPixel(hDC, X, Y) <> cTransparent
  60.                     X = X + 1
  61.                 Wend
  62. 'Mark the start of a line of transparent pixels
  63.                 X0 = X
  64. 'Scan a line of transparent pixels
  65.                 While X <= BM.bmWidth And GetPixel(hDC, X, Y) = cTransparent
  66.                     X = X + 1
  67.                 Wend
  68. 'Create a new Region that corresponds to the row of
  69. 'Transparent pixels and then remove it from the main
  70. 'Region
  71.                 If X0 < X Then
  72.                     tRgn = CreateRectRgn(X0, Y, X, Y + 1)
  73.                     CombineRgn hRgn, hRgn, tRgn, 4
  74. 'Free the memory used by the new temporary Region
  75.                     DeleteObject tRgn
  76.                 End If
  77.             Next X
  78.         Next Y
  79. 'Return the memory address to the shaped region
  80.         GetBitmapRegion = hRgn
  81. 'Free memory by deleting the Picture
  82.         DeleteObject SelectObject(hDC, cPicture)
  83.     End If
  84. 'Free memory by deleting the created DC
  85.     DeleteDC hDC
  86. End Function
  87.